home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / apel / emu-20.el.z / emu-20.el
Encoding:
Text File  |  1998-05-21  |  4.9 KB  |  171 lines
  1. ;;; emu-20.el --- emu API implementation for Emacs 20 and XEmacs/mule
  2.  
  3. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Version: $Id: emu-20.el,v 7.18 1997/11/04 08:36:40 morioka Exp $
  7. ;; Keywords: emulation, compatibility, Mule
  8.  
  9. ;; This file is part of emu.
  10.  
  11. ;; This program is free software; you can redistribute it and/or
  12. ;; modify it under the terms of the GNU General Public License as
  13. ;; published by the Free Software Foundation; either version 2, or (at
  14. ;; your option) any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;    This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
  29. ;;    or later.
  30.  
  31. ;;; Code:
  32.  
  33. (require 'custom)
  34.  
  35.  
  36. ;;; @ binary access
  37. ;;;
  38.  
  39. (defmacro as-binary-process (&rest body)
  40.   `(let (selective-display    ; Disable ^M to nl translation.
  41.      (coding-system-for-read  'binary)
  42.      (coding-system-for-write 'binary))
  43.      ,@body))
  44.  
  45. (defmacro as-binary-input-file (&rest body)
  46.   `(let ((coding-system-for-read 'binary))
  47.      ,@body))
  48.  
  49. (defmacro as-binary-output-file (&rest body)
  50.   `(let ((coding-system-for-write 'binary))
  51.      ,@body))
  52.  
  53. (defun insert-binary-file-contents-literally
  54.   (filename &optional visit beg end replace)
  55.   "Like `insert-file-contents-literally', q.v., but don't code conversion.
  56. A buffer may be modified in several ways after reading into the buffer due
  57. to advanced Emacs features, such as file-name-handlers, format decoding,
  58. find-file-hooks, etc.
  59.   This function ensures that none of these modifications will take place."
  60.   (let ((coding-system-for-read 'binary))
  61.     (insert-file-contents-literally filename visit beg end replace)
  62.     ))
  63.  
  64. ;;; @@ Mule emulating aliases
  65. ;;;
  66. ;;; You should not use it.
  67.  
  68. (defconst *noconv* 'binary
  69.   "Coding-system for binary.
  70. This constant is defined to emulate old MULE anything older than MULE
  71. 2.3.  It is obsolete, so don't use it.")
  72.  
  73.  
  74. ;;; @ MIME charset
  75. ;;;
  76.  
  77. (defvar mime-charset-coding-system-alist
  78.   `,(let ((rest
  79.        '((us-ascii      . iso-8859-1)
  80.          (gb2312        . cn-gb-2312)
  81.          (iso-2022-jp-2 . iso-2022-7bit-ss2)
  82.          (x-ctext       . ctext)
  83.          ))
  84.       dest)
  85.       (while rest
  86.     (let ((pair (car rest)))
  87.       (or (find-coding-system (car pair))
  88.           (setq dest (cons pair dest))
  89.           ))
  90.     (setq rest (cdr rest))
  91.     )
  92.       dest)
  93.   "Alist MIME CHARSET vs CODING-SYSTEM.
  94. MIME CHARSET and CODING-SYSTEM must be symbol.")
  95.  
  96. (defun mime-charset-to-coding-system (charset &optional lbt)
  97.   "Return coding-system corresponding with CHARSET.
  98. CHARSET is a symbol whose name is MIME charset.
  99. If optional argument LBT (`unix', `dos' or `mac') is specified, it is
  100. used as line break code type of coding-system."
  101.   (if (stringp charset)
  102.       (setq charset (intern (downcase charset)))
  103.     )
  104.   (let ((ret (assq charset mime-charset-coding-system-alist)))
  105.     (if ret
  106.     (setq charset (cdr ret))
  107.       ))
  108.   (if lbt
  109.       (setq charset (intern (format "%s-%s" charset lbt)))
  110.     )
  111.   (if (find-coding-system charset)
  112.       charset))
  113.  
  114. (defun mime-charset-list ()
  115.   "Return a list of all existing MIME-charset."
  116.   (nconc (mapcar (function car) mime-charset-coding-system-alist)
  117.      (coding-system-list)))
  118.  
  119.  
  120. (defvar widget-mime-charset-prompt-value-history nil
  121.   "History of input to `widget-mime-charset-prompt-value'.")
  122.  
  123. (define-widget 'mime-charset 'coding-system
  124.   "A mime-charset."
  125.   :format "%{%t%}: %v"
  126.   :tag "MIME-charset"
  127.   :prompt-history 'widget-mime-charset-prompt-value-history
  128.   :prompt-value 'widget-mime-charset-prompt-value
  129.   :action 'widget-mime-charset-action)
  130.  
  131. (defun widget-mime-charset-prompt-value (widget prompt value unbound)
  132.   ;; Read mime-charset from minibuffer.
  133.   (intern
  134.    (completing-read (format "%s (default %s) " prompt value)
  135.             (mapcar (function
  136.                  (lambda (sym)
  137.                    (list (symbol-name sym))
  138.                    ))
  139.                 (mime-charset-list)))))
  140.  
  141. (defun widget-mime-charset-action (widget &optional event)
  142.   ;; Read a mime-charset from the minibuffer.
  143.   (let ((answer
  144.      (widget-mime-charset-prompt-value
  145.       widget
  146.       (widget-apply widget :menu-tag-get)
  147.       (widget-value widget)
  148.       t)))
  149.     (widget-value-set widget answer)
  150.     (widget-apply widget :notify widget event)
  151.     (widget-setup)))
  152.  
  153. (defcustom default-mime-charset 'x-ctext
  154.   "Default value of MIME-charset.
  155. It is used when MIME-charset is not specified.
  156. It must be symbol."
  157.   :group 'i18n
  158.   :type 'mime-charset)
  159.  
  160. (defun detect-mime-charset-region (start end)
  161.   "Return MIME charset for region between START and END."
  162.   (charsets-to-mime-charset (find-charset-region start end)))
  163.  
  164.  
  165. ;;; @ end
  166. ;;;
  167.  
  168. (provide 'emu-20)
  169.  
  170. ;;; emu-20.el ends here
  171.